home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2007 September / PCWSEP07.iso / Software / Linux / Linux Mint 3.0 Light / LinuxMint-3.0-Light.iso / casper / filesystem.squashfs / usr / share / perl / 5.8.8 / warnings.pm < prev   
Encoding:
Perl POD Document  |  2007-03-05  |  12.7 KB  |  374 lines
  1. # -*- buffer-read-only: t -*-
  2. # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
  3. # This file was created by warnings.pl
  4. # Any changes made here will be lost.
  5. #
  6.  
  7. package warnings;
  8.  
  9. our $VERSION = '1.05';
  10.  
  11. use Carp ();
  12.  
  13. our %Offsets = (
  14.  
  15.     # Warnings Categories added in Perl 5.008
  16.  
  17.     'all'        => 0,
  18.     'closure'        => 2,
  19.     'deprecated'    => 4,
  20.     'exiting'        => 6,
  21.     'glob'        => 8,
  22.     'io'        => 10,
  23.     'closed'        => 12,
  24.     'exec'        => 14,
  25.     'layer'        => 16,
  26.     'newline'        => 18,
  27.     'pipe'        => 20,
  28.     'unopened'        => 22,
  29.     'misc'        => 24,
  30.     'numeric'        => 26,
  31.     'once'        => 28,
  32.     'overflow'        => 30,
  33.     'pack'        => 32,
  34.     'portable'        => 34,
  35.     'recursion'        => 36,
  36.     'redefine'        => 38,
  37.     'regexp'        => 40,
  38.     'severe'        => 42,
  39.     'debugging'        => 44,
  40.     'inplace'        => 46,
  41.     'internal'        => 48,
  42.     'malloc'        => 50,
  43.     'signal'        => 52,
  44.     'substr'        => 54,
  45.     'syntax'        => 56,
  46.     'ambiguous'        => 58,
  47.     'bareword'        => 60,
  48.     'digit'        => 62,
  49.     'parenthesis'    => 64,
  50.     'precedence'    => 66,
  51.     'printf'        => 68,
  52.     'prototype'        => 70,
  53.     'qw'        => 72,
  54.     'reserved'        => 74,
  55.     'semicolon'        => 76,
  56.     'taint'        => 78,
  57.     'threads'        => 80,
  58.     'uninitialized'    => 82,
  59.     'unpack'        => 84,
  60.     'untie'        => 86,
  61.     'utf8'        => 88,
  62.     'void'        => 90,
  63.     'y2k'        => 92,
  64.   );
  65.  
  66. our %Bits = (
  67.     'all'        => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..46]
  68.     'ambiguous'        => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
  69.     'bareword'        => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
  70.     'closed'        => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
  71.     'closure'        => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
  72.     'debugging'        => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
  73.     'deprecated'    => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
  74.     'digit'        => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
  75.     'exec'        => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
  76.     'exiting'        => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
  77.     'glob'        => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
  78.     'inplace'        => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
  79.     'internal'        => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
  80.     'io'        => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
  81.     'layer'        => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
  82.     'malloc'        => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
  83.     'misc'        => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
  84.     'newline'        => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
  85.     'numeric'        => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
  86.     'once'        => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
  87.     'overflow'        => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
  88.     'pack'        => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
  89.     'parenthesis'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
  90.     'pipe'        => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
  91.     'portable'        => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
  92.     'precedence'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
  93.     'printf'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
  94.     'prototype'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
  95.     'qw'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
  96.     'recursion'        => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
  97.     'redefine'        => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
  98.     'regexp'        => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
  99.     'reserved'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
  100.     'semicolon'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
  101.     'severe'        => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00", # [21..25]
  102.     'signal'        => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
  103.     'substr'        => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
  104.     'syntax'        => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x00", # [28..38]
  105.     'taint'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
  106.     'threads'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
  107.     'uninitialized'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
  108.     'unopened'        => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
  109.     'unpack'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
  110.     'untie'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
  111.     'utf8'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
  112.     'void'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
  113.     'y2k'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
  114.   );
  115.  
  116. our %DeadBits = (
  117.     'all'        => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..46]
  118.     'ambiguous'        => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
  119.     'bareword'        => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
  120.     'closed'        => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
  121.     'closure'        => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
  122.     'debugging'        => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
  123.     'deprecated'    => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
  124.     'digit'        => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
  125.     'exec'        => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
  126.     'exiting'        => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
  127.     'glob'        => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
  128.     'inplace'        => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
  129.     'internal'        => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
  130.     'io'        => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
  131.     'layer'        => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
  132.     'malloc'        => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
  133.     'misc'        => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
  134.     'newline'        => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
  135.     'numeric'        => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
  136.     'once'        => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
  137.     'overflow'        => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
  138.     'pack'        => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
  139.     'parenthesis'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
  140.     'pipe'        => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
  141.     'portable'        => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
  142.     'precedence'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
  143.     'printf'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
  144.     'prototype'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
  145.     'qw'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
  146.     'recursion'        => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
  147.     'redefine'        => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
  148.     'regexp'        => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
  149.     'reserved'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
  150.     'semicolon'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
  151.     'severe'        => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00", # [21..25]
  152.     'signal'        => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
  153.     'substr'        => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
  154.     'syntax'        => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x00", # [28..38]
  155.     'taint'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
  156.     'threads'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
  157.     'uninitialized'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
  158.     'unopened'        => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
  159.     'unpack'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
  160.     'untie'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
  161.     'utf8'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
  162.     'void'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
  163.     'y2k'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
  164.   );
  165.  
  166. $NONE     = "\0\0\0\0\0\0\0\0\0\0\0\0";
  167. $LAST_BIT = 94 ;
  168. $BYTES    = 12 ;
  169.  
  170. $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
  171.  
  172. sub Croaker
  173. {
  174.     local $Carp::CarpInternal{'warnings'};
  175.     delete $Carp::CarpInternal{'warnings'};
  176.     Carp::croak(@_);
  177. }
  178.  
  179. sub bits
  180. {
  181.     # called from B::Deparse.pm
  182.  
  183.     push @_, 'all' unless @_;
  184.  
  185.     my $mask;
  186.     my $catmask ;
  187.     my $fatal = 0 ;
  188.     my $no_fatal = 0 ;
  189.  
  190.     foreach my $word ( @_ ) {
  191.     if ($word eq 'FATAL') {
  192.         $fatal = 1;
  193.         $no_fatal = 0;
  194.     }
  195.     elsif ($word eq 'NONFATAL') {
  196.         $fatal = 0;
  197.         $no_fatal = 1;
  198.     }
  199.     elsif ($catmask = $Bits{$word}) {
  200.         $mask |= $catmask ;
  201.         $mask |= $DeadBits{$word} if $fatal ;
  202.         $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
  203.     }
  204.     else
  205.           { Croaker("Unknown warnings category '$word'")}
  206.     }
  207.  
  208.     return $mask ;
  209. }
  210.  
  211. sub import 
  212. {
  213.     shift;
  214.  
  215.     my $catmask ;
  216.     my $fatal = 0 ;
  217.     my $no_fatal = 0 ;
  218.  
  219.     my $mask = ${^WARNING_BITS} ;
  220.  
  221.     if (vec($mask, $Offsets{'all'}, 1)) {
  222.         $mask |= $Bits{'all'} ;
  223.         $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
  224.     }
  225.     
  226.     push @_, 'all' unless @_;
  227.  
  228.     foreach my $word ( @_ ) {
  229.     if ($word eq 'FATAL') {
  230.         $fatal = 1;
  231.         $no_fatal = 0;
  232.     }
  233.     elsif ($word eq 'NONFATAL') {
  234.         $fatal = 0;
  235.         $no_fatal = 1;
  236.     }
  237.     elsif ($catmask = $Bits{$word}) {
  238.         $mask |= $catmask ;
  239.         $mask |= $DeadBits{$word} if $fatal ;
  240.         $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
  241.     }
  242.     else
  243.           { Croaker("Unknown warnings category '$word'")}
  244.     }
  245.  
  246.     ${^WARNING_BITS} = $mask ;
  247. }
  248.  
  249. sub unimport 
  250. {
  251.     shift;
  252.  
  253.     my $catmask ;
  254.     my $mask = ${^WARNING_BITS} ;
  255.  
  256.     if (vec($mask, $Offsets{'all'}, 1)) {
  257.         $mask |= $Bits{'all'} ;
  258.         $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
  259.     }
  260.  
  261.     push @_, 'all' unless @_;
  262.  
  263.     foreach my $word ( @_ ) {
  264.     if ($word eq 'FATAL') {
  265.         next; 
  266.     }
  267.     elsif ($catmask = $Bits{$word}) {
  268.         $mask &= ~($catmask | $DeadBits{$word} | $All);
  269.     }
  270.     else
  271.           { Croaker("Unknown warnings category '$word'")}
  272.     }
  273.  
  274.     ${^WARNING_BITS} = $mask ;
  275. }
  276.  
  277. my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
  278.  
  279. sub __chk
  280. {
  281.     my $category ;
  282.     my $offset ;
  283.     my $isobj = 0 ;
  284.  
  285.     if (@_) {
  286.         # check the category supplied.
  287.         $category = shift ;
  288.         if (my $type = ref $category) {
  289.             Croaker("not an object")
  290.                 if exists $builtin_type{$type};
  291.         $category = $type;
  292.             $isobj = 1 ;
  293.         }
  294.         $offset = $Offsets{$category};
  295.         Croaker("Unknown warnings category '$category'")
  296.         unless defined $offset;
  297.     }
  298.     else {
  299.         $category = (caller(1))[0] ;
  300.         $offset = $Offsets{$category};
  301.         Croaker("package '$category' not registered for warnings")
  302.         unless defined $offset ;
  303.     }
  304.  
  305.     my $this_pkg = (caller(1))[0] ;
  306.     my $i = 2 ;
  307.     my $pkg ;
  308.  
  309.     if ($isobj) {
  310.         while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
  311.             last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
  312.         }
  313.     $i -= 2 ;
  314.     }
  315.     else {
  316.         for ($i = 2 ; $pkg = (caller($i))[0] ; ++ $i) {
  317.             last if $pkg ne $this_pkg ;
  318.         }
  319.         $i = 2
  320.             if !$pkg || $pkg eq $this_pkg ;
  321.     }
  322.  
  323.     my $callers_bitmask = (caller($i))[9] ;
  324.     return ($callers_bitmask, $offset, $i) ;
  325. }
  326.  
  327. sub enabled
  328. {
  329.     Croaker("Usage: warnings::enabled([category])")
  330.     unless @_ == 1 || @_ == 0 ;
  331.  
  332.     my ($callers_bitmask, $offset, $i) = __chk(@_) ;
  333.  
  334.     return 0 unless defined $callers_bitmask ;
  335.     return vec($callers_bitmask, $offset, 1) ||
  336.            vec($callers_bitmask, $Offsets{'all'}, 1) ;
  337. }
  338.  
  339. sub warn
  340. {
  341.     Croaker("Usage: warnings::warn([category,] 'message')")
  342.     unless @_ == 2 || @_ == 1 ;
  343.  
  344.     my $message = pop ;
  345.     my ($callers_bitmask, $offset, $i) = __chk(@_) ;
  346.     Carp::croak($message)
  347.     if vec($callers_bitmask, $offset+1, 1) ||
  348.        vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
  349.     Carp::carp($message) ;
  350. }
  351.  
  352. sub warnif
  353. {
  354.     Croaker("Usage: warnings::warnif([category,] 'message')")
  355.     unless @_ == 2 || @_ == 1 ;
  356.  
  357.     my $message = pop ;
  358.     my ($callers_bitmask, $offset, $i) = __chk(@_) ;
  359.  
  360.     return
  361.         unless defined $callers_bitmask &&
  362.                 (vec($callers_bitmask, $offset, 1) ||
  363.                 vec($callers_bitmask, $Offsets{'all'}, 1)) ;
  364.  
  365.     Carp::croak($message)
  366.     if vec($callers_bitmask, $offset+1, 1) ||
  367.        vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
  368.  
  369.     Carp::carp($message) ;
  370. }
  371.  
  372. 1;
  373. # ex: set ro:
  374.